home *** CD-ROM | disk | FTP | other *** search
/ Alles Voor Internet / Tout Pour Internet / alles voor internet.iso / MacInternet™ / Unix / ftpget.shar / ftp.pl next >
Encoding:
Perl Script  |  1993-05-21  |  21.9 KB  |  1,031 lines
  1. #-*-perl-*-
  2. # This is a wrapper to the chat2.pl routines that make life easier
  3. # to do ftp type work.
  4. # Written by Alan R. Martello <al@ee.pitt.edu>
  5. # Some bug fixes and extensions by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  6. # And by A.Macpherson@bnr.co.uk for multi-homed hosts
  7. #
  8. # $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.13 1992/03/20 21:01:03 lmjm Exp lmjm $
  9. # $Log: ftp.pl,v $
  10. # Revision 1.13  1992/03/20  21:01:03  lmjm
  11. # Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
  12. # Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
  13. #
  14. # Revision 1.12  1992/02/06  23:25:56  lmjm
  15. # Moved code around so can use this as a lib for both mirror and ftpmail.
  16. # Time out opens.  In case Unix doesn't bother to.
  17. #
  18. # Revision 1.11  1991/11/27  22:05:57  lmjm
  19. # Match the response code number at the start of a line allowing
  20. # for any leading junk.
  21. #
  22. # Revision 1.10  1991/10/23  22:42:20  lmjm
  23. # Added better timeout code.
  24. # Tried to optimise file transfer
  25. # Moved open/close code to not leak file handles.
  26. # Cleaned up the alarm code.
  27. # Added $fatalerror to show wether the ftp link is really dead.
  28. #
  29. # Revision 1.9  1991/10/07  18:30:35  lmjm
  30. # Made the timeout-read code work.
  31. # Added restarting file gets.
  32. # Be more verbose if ever have to call die.
  33. #
  34. # Revision 1.8  1991/09/17  22:53:16  lmjm
  35. # Spot when open_data_socket fails and return a failure rather than dying.
  36. #
  37. # Revision 1.7  1991/09/12  22:40:25  lmjm
  38. # Added Andrew Macpherson's patches for hosts without ip forwarding.
  39. #
  40. # Revision 1.6  1991/09/06  19:53:52  lmjm
  41. # Relaid out the code the way I like it!
  42. # Changed the debuggin to produce more "appropriate" messages
  43. # Fixed bugs in the ordering of put and dir listing.
  44. # Allow for hash printing when getting files (a la ftp).
  45. # Added the new commands from Al.
  46. # Don't print passwords in debugging.
  47. #
  48. # Revision 1.5  1991/08/29  16:23:49  lmjm
  49. # Timeout reads from the remote ftp server.
  50. # No longer call die expect on fatal errors.  Just return fail codes.
  51. # Changed returns so higher up routines can tell whats happening.
  52. # Get expect/accept in correct order for dir listing.
  53. # When ftp_show is set then print hashes every 1k transfered (like ftp).
  54. # Allow for stripping returns out of incoming data.
  55. # Save last error in a global string.
  56. #
  57. # Revision 1.4  1991/08/14  21:04:58  lmjm
  58. # ftp'get now copes with ungetable files.
  59. # ftp'expect code changed such that the string_to_print is
  60. # ignored and the string sent back from the remote system is printed
  61. # instead.
  62. # Implemented patches from al.  Removed spuiours tracing statements.
  63. #
  64. # Revision 1.3  1991/08/09  21:32:18  lmjm
  65. # Allow for another ok code on cwd's
  66. # Rejigger the log levels
  67. # Send \r\n for some odd ftp daemons
  68. #
  69. # Revision 1.2  1991/08/09  18:07:37  lmjm
  70. # Don't print messages unless ftp_show says to.
  71. #
  72. # Revision 1.1  1991/08/08  20:31:00  lmjm
  73. # Initial revision
  74. #
  75.  
  76. require 'chat2.pl';
  77. require 'socket.ph';
  78.  
  79.  
  80. package ftp;
  81.  
  82. # If the remote ftp daemon doesn't respond within this time presume its dead
  83. # or something.
  84. $timeout = 30;
  85.  
  86. # Timeout a read if I don't get data back within this many seconds
  87. $timeout_read = 20 * $timeout;
  88.  
  89. # Timeout an open
  90. $timeout_open = $timeout;
  91.  
  92. # This is a "global" it contains the last response from the remote ftp server
  93. # for use in error messages
  94. $ftp'response = "";
  95. # Also ftp'NS is the socket containing the data coming in from the remote ls
  96. # command.
  97.  
  98. # The size of block to be read or written when talking to the remote
  99. # ftp server
  100. $ftp'ftpbufsize = 4096;
  101.  
  102. # How often to print a hash out, when debugging
  103. $ftp'hashevery = 1024;
  104. # Output a newline after this many hashes to prevent outputing very long lines
  105. $ftp'hashnl = 70;
  106.  
  107. # If a proxy connection then who am I really talking to?
  108. $real_site = "";
  109.  
  110. # This is just a tracing aid.
  111. $ftp_show = 0;
  112. sub ftp'debug
  113. {
  114.     $ftp_show = @_[0];
  115. #    if( $ftp_show ){
  116. #        print "ftp debugging on\n";
  117. #    }
  118. }
  119.  
  120. sub ftp'set_timeout
  121. {
  122.     $timeout = @_[0];
  123.     $timeout_open = $timeout;
  124.     $timeout_read = 20 * $timeout;
  125.     if( $ftp_show ){
  126.         print "ftp timeout set to $timeout\n";
  127.     }
  128. }
  129.  
  130.  
  131. sub ftp'open_alarm
  132. {
  133.     die "timeout: open";
  134. }
  135.  
  136. sub ftp'timed_open
  137. {
  138.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  139.     local( $connect_site, $connect_port );
  140.     local( $res );
  141.  
  142.     alarm( $timeout_open );
  143.  
  144.     while( $attempts-- ){
  145.         if( $ftp_show ){
  146.             print "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
  147.             print "Connecting to $site";
  148.             if( $ftp_port != 21 ){
  149.                 print " [port $ftp_port]";
  150.             }
  151.             print "\n";
  152.         }
  153.         
  154.         if( $proxy ) {
  155.             if( ! $proxy_gateway ) {
  156.                 # if not otherwise set
  157.                 $proxy_gateway = "internet-gateway";
  158.             }
  159.             if( $debug ) {
  160.                 print "using proxy services of $proxy_gateway, ";
  161.                 print "at $proxy_ftp_port\n";
  162.             }
  163.             $connect_site = $proxy_gateway;
  164.             $connect_port = $proxy_ftp_port;
  165.             $real_site = $site;
  166.         }
  167.         else {
  168.             $connect_site = $site;
  169.             $connect_port = $ftp_port;
  170.         }
  171.         if( ! &chat'open_port( $connect_site, $connect_port ) ){
  172.             if( $retry_call ){
  173.                 print "Failed to connect\n" if $ftp_show;
  174.                 next;
  175.             }
  176.             else {
  177.                 print "proxy connection failed " if $proxy;
  178.                 print "Cannot open ftp to $connect_site\n" if $ftp_show;
  179.                 return 0;
  180.             }
  181.         }
  182.         $res = &ftp'expect( $timeout,
  183.                     120, "service unavailable to $site", 0, 
  184.                                 220, "ready for login to $site", 1,
  185.                     421, "service unavailable to $site, closing connection", 0);
  186.         if( ! $res ){
  187.             &chat'close();
  188.             next;
  189.         }
  190.         return 1;
  191.     }
  192.     continue {
  193.         print "Pausing between retries\n";
  194.         sleep( $retry_pause );
  195.     }
  196.     return 0;
  197. }
  198.  
  199. sub ftp'open
  200. {
  201.     local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  202.  
  203.     $SIG{ 'ALRM' } = "ftp\'open_alarm";
  204.  
  205.     local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
  206.     alarm( 0 );
  207.  
  208.     if( $@ =~ /^timeout/ ){
  209.         return -1;
  210.     }
  211.     return $ret;
  212. }
  213.  
  214. sub ftp'login
  215. {
  216.     local( $remote_user, $remote_password ) = @_;
  217.  
  218.     if( $proxy ){
  219.         &ftp'send( "USER $remote_user@$site" );
  220.     }
  221.     else {
  222.         &ftp'send( "USER $remote_user" );
  223.     }
  224.         local( $val ) =
  225.                &ftp'expect($timeout,
  226.                230, "$remote_user logged in", 1,
  227.            331, "send password for $remote_user", 2,
  228.  
  229.            500, "syntax error", 0,
  230.            501, "syntax error", 0,
  231.            530, "not logged in", 0,
  232.            332, "account for login not supported", 0,
  233.  
  234.            421, "service unavailable, closing connection", 0);
  235.     if( $val == 1 ){
  236.         return 1;
  237.     }
  238.     if( $val == 2 ){
  239.         # A password is needed
  240.         &ftp'send( "PASS $remote_password" );
  241.  
  242.         $val = &ftp'expect( $timeout,
  243. #           "[.|\n]*^230", "$remote_user logged in", 1,
  244.            230, "$remote_user logged in", 1,
  245.  
  246.            202, "command not implemented", 0,
  247.            332, "account for login not supported", 0,
  248.  
  249.            530, "not logged in", 0,
  250.            500, "syntax error", 0,
  251.            501, "syntax error", 0,
  252.            503, "bad sequence of commands", 0, 
  253.  
  254.            421, "service unavailable, closing connection", 0);
  255.         if( $val == 1){
  256.             # Logged in
  257.             return 1;
  258.         }
  259.     }
  260.     # If I got here I failed to login
  261.     return 0;
  262. }
  263.  
  264. sub ftp'close
  265. {
  266.     &ftp'quit();
  267.     &chat'close();
  268. }
  269.  
  270. # Change directory
  271. # return 1 if successful
  272. # 0 on a failure
  273. sub ftp'cwd
  274. {
  275.     local( $dir ) = @_;
  276.  
  277.     &ftp'send( "CWD $dir" );
  278.  
  279.     return &ftp'expect( $timeout,
  280.         200, "working directory = $dir", 1,
  281.         250, "working directory = $dir", 1,
  282.  
  283.         500, "syntax error", 0,
  284.         501, "syntax error", 0,
  285.                 502, "command not implemented", 0,
  286.         530, "not logged in", 0,
  287.                 550, "cannot change directory", 0,
  288.         421, "service unavailable, closing connection", 0 );
  289. }
  290.  
  291. # Get a full directory listing:
  292. # &ftp'dir( remote LIST options )
  293. # Start a list goin with the given options.
  294. # Presuming that the remote deamon uses the ls command to generate the
  295. # data to send back then then you can send it some extra options (eg: -lRa)
  296. # return 1 if sucessful and 0 on a failure
  297. sub ftp'dir_open
  298. {
  299.     local( $options ) = @_;
  300.     local( $ret );
  301.     
  302.     if( ! &ftp'open_data_socket() ){
  303.         return 0;
  304.     }
  305.     
  306.     if( $options ){
  307.         &ftp'send( "LIST $options" );
  308.     }
  309.     else {
  310.         &ftp'send( "LIST" );
  311.     }
  312.     
  313.     $ret = &ftp'expect( $timeout,
  314.         150, "reading directory", 1,
  315.     
  316.         125, "data connection already open?", 0,
  317.     
  318.         450, "file unavailable", 0,
  319.         500, "syntax error", 0,
  320.         501, "syntax error", 0,
  321.         502, "command not implemented", 0,
  322.         530, "not logged in", 0,
  323.     
  324.            421, "service unavailable, closing connection", 0 );
  325.     if( ! $ret ){
  326.         &ftp'close_data_socket;
  327.         return 0;
  328.     }
  329.     
  330.     # 
  331.     # the data should be coming at us now
  332.     #
  333.     
  334.     # now accept
  335.     accept(NS,S) || die "accept failed $!";
  336.     
  337.     return 1;
  338. }
  339.  
  340.  
  341. # Close down reading the result of a remote ls command
  342. # return 1 if successful and 0 on failure
  343. sub ftp'dir_close
  344. {
  345.     local( $ret );
  346.  
  347.     # read the close
  348.     #
  349.     $ret = &ftp'expect($timeout,
  350.             226, "", 1,     # transfer complete, closing connection
  351.             250, "", 1,     # action completed
  352.  
  353.             425, "can't open data connection", 0,
  354.             426, "connection closed, transfer aborted", 0,
  355.             451, "action aborted, local error", 0,
  356.             421, "service unavailable, closing connection", 0);
  357.  
  358.     # shut down our end of the socket
  359.     &ftp'close_data_socket;
  360.  
  361.     if( ! $ret ){
  362.         return 0;
  363.     }
  364.  
  365.     return 1;
  366. }
  367.  
  368. # Quit from the remote ftp server
  369. # return 1 if successful and 0 on failure
  370. sub ftp'quit
  371. {
  372.     $site_command_check = 0;
  373.     @site_command_list = ();
  374.  
  375.     &ftp'send("QUIT");
  376.  
  377.     return &ftp'expect($timeout, 
  378.         221, "Goodbye", 1,     # transfer complete, closing connection
  379.     
  380.         500, "error quitting??", 0);
  381. }
  382.  
  383. sub ftp'read_alarm
  384. {
  385.     die "timeout: read";
  386. }
  387.  
  388. sub ftp'timed_read
  389. {
  390.     alarm( $timeout_read );
  391.     return sysread( NS, $buf, $ftpbufsize );
  392. }
  393.  
  394. sub ftp'read
  395. {
  396.     $SIG{ 'ALRM' } = "ftp\'read_alarm";
  397.  
  398.     local( $ret ) = eval '&timed_read()';
  399.     alarm( 0 );
  400.  
  401.     if( $@ =~ /^timeout/ ){
  402.         return -1;
  403.     }
  404.     return $ret;
  405. }
  406.  
  407. # Get a remote file back into a local file.
  408. # If no loc_fname passed then uses rem_fname.
  409. # returns 1 on success and 0 on failure
  410. sub ftp'get
  411. {
  412.     local($rem_fname, $loc_fname, $restart ) = @_;
  413.     
  414.     if ($loc_fname eq "") {
  415.         $loc_fname = $rem_fname;
  416.     }
  417.     
  418.     if( ! &ftp'open_data_socket() ){
  419.         print "Cannot open data socket\n";
  420.         return 0;
  421.     }
  422.  
  423.     # Find the size of the target file
  424.     local( $restart_at ) = &ftp'filesize( $loc_fname );
  425.     if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
  426.         $restart = 1;
  427.         # Make sure the file can be updated
  428.         chmod( 0644, $loc_fname );
  429.     }
  430.     else {
  431.         $restart = 0;
  432.         unlink( $loc_fname );
  433.     }
  434.  
  435.     &ftp'send( "RETR $rem_fname" );
  436.     
  437.     local( $ret ) =
  438.         &ftp'expect($timeout, 
  439.                    150, "receiving $loc_fname", 1,
  440.  
  441.                    125, "data connection already open?", 0,
  442.  
  443.                    450, "file unavailable", 2,
  444.                    550, "file unavailable", 2,
  445.  
  446.            500, "syntax error", 0,
  447.            501, "syntax error", 0,
  448.            530, "not logged in", 0,
  449.  
  450.            421, "service unavailable, closing connection", 0);
  451.     if( $ret != 1 ){
  452.         print "Failure on RETR command\n";
  453.  
  454.         # shut down our end of the socket
  455.         &ftp'close_data_socket;
  456.  
  457.         return 0;
  458.     }
  459.  
  460.     # 
  461.     # the data should be coming at us now
  462.     #
  463.  
  464.     # now accept
  465.     accept(NS,S) || die "accept failed: $!";
  466.  
  467.     #
  468.     #  open the local fname
  469.     #  concatenate on the end if restarting, else just overwrite
  470.     if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
  471.         print "Cannot create local file $loc_fname\n";
  472.  
  473.         # shut down our end of the socket
  474.         &ftp'close_data_socket;
  475.  
  476.         return 0;
  477.     }
  478.  
  479. #    while (<NS>) {
  480. #        print FH ;
  481. #    }
  482.  
  483.     local( $start_time ) = time;
  484.     local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
  485.     while( ($len = &ftp'read()) > 0 ){
  486.         $bytes += $len;
  487.         if( $strip_cr ){
  488.             $ftp'buf =~ s/\r//g;
  489.         }
  490.         if( $ftp_show ){
  491.             while( $bytes > ($lasthash + $ftp'hashevery) ){
  492.                 print '#';
  493.                 $lasthash += $ftp'hashevery;
  494.                 $hashes++;
  495.                 if( ($hashes % $ftp'hashnl) == 0 ){
  496.                     print "\n";
  497.                 }
  498.             }
  499.         }
  500.         print FH $ftp'buf;
  501.     }
  502.     close( FH );
  503.  
  504.     # shut down our end of the socket
  505.     &ftp'close_data_socket;
  506.  
  507.     if( $len < 0 ){
  508.         print "\ntimed out reading data!\n";
  509.  
  510.         return 0;
  511.     }
  512.         
  513.     if( $ftp_show ){
  514.         if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
  515.             print "\n";
  516.         }
  517.         local( $secs ) = (time - $start_time);
  518.         if( $secs <= 0 ){
  519.             $secs = 1; # To avoid a devide by zero;
  520.         }
  521.  
  522.         local( $rate ) = int( $bytes / $secs );
  523.         print "Got $bytes bytes ($rate bytes/sec)\n";
  524.     }
  525.  
  526.     #
  527.     # read the close
  528.     #
  529.  
  530.     $ret = &ftp'expect($timeout, 
  531.         226, "Got file", 1,     # transfer complete, closing connection
  532.             250, "Got file", 1,     # action completed
  533.     
  534.             110, "restart not supported", 0,
  535.             425, "can't open data connection", 0,
  536.             426, "connection closed, transfer aborted", 0,
  537.             451, "action aborted, local error", 0,
  538.         421, "service unavailable, closing connection", 0);
  539.  
  540.     return $ret;
  541. }
  542.  
  543. sub ftp'delete
  544. {
  545.     local( $rem_fname, $val ) = @_;
  546.  
  547.     &ftp'send("DELE $rem_fname" );
  548.     $val = &ftp'expect( $timeout, 
  549.                250,"Deleted $rem_fname", 1,
  550.                550,"Permission denied",0
  551.                );
  552.     return $val == 1;
  553. }
  554.  
  555. sub ftp'deldir
  556. {
  557.     local( $fname ) = @_;
  558.  
  559.     # not yet implemented
  560.     # RMD
  561. }
  562.  
  563. # UPDATE ME!!!!!!
  564. # Add in the hash printing and newline conversion
  565. sub ftp'put
  566. {
  567.     local( $loc_fname, $rem_fname ) = @_;
  568.     local( $strip_cr );
  569.     
  570.     if ($loc_fname eq "") {
  571.         $loc_fname = $rem_fname;
  572.     }
  573.     
  574.     if( ! &ftp'open_data_socket() ){
  575.         return 0;
  576.     }
  577.     
  578.     &ftp'send("STOR $rem_fname");
  579.     
  580.     # 
  581.     # the data should be coming at us now
  582.     #
  583.     
  584.     local( $ret ) =
  585.     &ftp'expect($timeout, 
  586.         150, "sending $loc_fname", 1,
  587.  
  588.         125, "data connection already open?", 0,
  589.         450, "file unavailable", 0,
  590.  
  591.         532, "need account for storing files", 0,
  592.         452, "insufficient storage on system", 0,
  593.         553, "file name not allowed", 0,
  594.  
  595.         500, "syntax error", 0,
  596.         501, "syntax error", 0,
  597.         530, "not logged in", 0,
  598.  
  599.         421, "service unavailable, closing connection", 0);
  600.  
  601.     if( $ret != 1 ){
  602.         # shut down our end of the socket
  603.         &ftp'close_data_socket;
  604.  
  605.         return 0;
  606.     }
  607.  
  608.  
  609.     # 
  610.     # the data should be coming at us now
  611.     #
  612.     
  613.     # now accept
  614.     accept(NS,S) || die "accept failed: $!";
  615.     
  616.     #
  617.     #  open the local fname
  618.     #
  619.     if( !open(FH, "<$loc_fname") ){
  620.         print "Cannot open local file $loc_fname\n";
  621.  
  622.         # shut down our end of the socket
  623.         &ftp'close_data_socket;
  624.  
  625.         return 0;
  626.     }
  627.     
  628.     while (<FH>) {
  629.         print NS ;
  630.     }
  631.     close(FH);
  632.     
  633.     # shut down our end of the socket to signal EOF
  634.     &ftp'close_data_socket;
  635.     
  636.     #
  637.     # read the close
  638.     #
  639.     
  640.     $ret = &ftp'expect($timeout, 
  641.         226, "file put", 1,     # transfer complete, closing connection
  642.         250, "file put", 1,     # action completed
  643.     
  644.         110, "restart not supported", 0,
  645.         425, "can't open data connection", 0,
  646.         426, "connection closed, transfer aborted", 0,
  647.         451, "action aborted, local error", 0,
  648.         551, "page type unknown", 0,
  649.         552, "storage allocation exceeded", 0,
  650.     
  651.         421, "service unavailable, closing connection", 0);
  652.     if( ! $ret ){
  653.         print "error putting $loc_fname\n";
  654.     }
  655.     return $ret;
  656. }
  657.  
  658. sub ftp'restart
  659. {
  660.     local( $restart_point, $ret ) = @_;
  661.  
  662.     &ftp'send("REST $restart_point");
  663.  
  664.     # 
  665.     # see what they say
  666.  
  667.     $ret = &ftp'expect($timeout, 
  668.                350, "restarting at $restart_point", 1,
  669.                
  670.                500, "syntax error", 0,
  671.                501, "syntax error", 0,
  672.                502, "REST not implemented", 2,
  673.                530, "not logged in", 0,
  674.                
  675.                421, "service unavailable, closing connection", 0);
  676.     return $ret;
  677. }
  678.  
  679. # Set the file transfer type
  680. sub ftp'type
  681. {
  682.     local( $type ) = @_;
  683.  
  684.     &ftp'send("TYPE $type");
  685.  
  686.     # 
  687.     # see what they say
  688.  
  689.     $ret = &ftp'expect($timeout, 
  690.                200, "file type set to $type", 1,
  691.                
  692.                500, "syntax error", 0,
  693.                501, "syntax error", 0,
  694.                504, "Invalid form or byte size for type $type", 0,
  695.                
  696.                421, "service unavailable, closing connection", 0);
  697.     return $ret;
  698. }
  699.  
  700. $site_command_check = 0;
  701. @site_command_list = ();
  702.  
  703. # routine to query the remote server for 'SITE' commands supported
  704. sub ftp'site_commands
  705. {
  706.     local( $ret );
  707.     
  708.     # if we havent sent a 'HELP SITE', send it now
  709.     if( !$site_command_check ){
  710.     
  711.         $site_command_check = 1;
  712.     
  713.         &ftp'send( "HELP SITE" );
  714.     
  715.         # assume the line in the HELP SITE response with the 'HELP'
  716.         # command is the one for us
  717.         $ret = &ftp'expect( $timeout,
  718.             ".*HELP.*", "", "\$1",
  719.             214, "", "0",
  720.             202, "", "0" );
  721.     
  722.         if( $ret eq "0" ){
  723.             print "No response from HELP SITE\n" if( $ftp_show );
  724.         }
  725.     
  726.         @site_command_list = split(/\s+/, $ret);
  727.     }
  728.     
  729.     return @site_command_list;
  730. }
  731.  
  732. # return the pwd, or null if we can't get the pwd
  733. sub ftp'pwd
  734. {
  735.     local( $ret, $cwd );
  736.  
  737.     &ftp'send( "PWD" );
  738.  
  739.     # 
  740.     # see what they say
  741.  
  742.     $ret = &ftp'expect( $timeout, 
  743. #               "257.*\\\"(.*)\\\"", "working directory is \$2", "\$2",
  744.                257, "working dir is", 1,
  745.                500, "syntax error", 0,
  746.                501, "syntax error", 0,
  747.                502, "PWD not implemented", 0,
  748.                        550, "file unavailable", 0,
  749.  
  750.                421, "service unavailable, closing connection", 0 );
  751.     if( $ret ){
  752.         if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
  753.             $cwd = $1;
  754.         }
  755.     }
  756.     return $cwd;
  757. }
  758.  
  759. # return 1 for success, 0 for failure
  760. sub ftp'mkdir
  761. {
  762.     local( $path ) = @_;
  763.     local( $ret );
  764.  
  765.     &ftp'send( "MKD $path" );
  766.  
  767.     # 
  768.     # see what they say
  769.  
  770.     $ret = &ftp'expect( $timeout, 
  771.                257, "made directory $path", 1,
  772.                
  773.                500, "syntax error", 0,
  774.                501, "syntax error", 0,
  775.                502, "MKD not implemented", 0,
  776.                530, "not logged in", 0,
  777.                        550, "file unavailable", 0,
  778.  
  779.                421, "service unavailable, closing connection", 0 );
  780.     return $ret;
  781. }
  782.  
  783. # return 1 for success, 0 for failure
  784. sub ftp'chmod
  785. {
  786.     local( $path, $mode ) = @_;
  787.     local( $ret );
  788.  
  789.     &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
  790.  
  791.     # 
  792.     # see what they say
  793.  
  794.     $ret = &ftp'expect( $timeout, 
  795.                200, "chmod $mode $path succeeded", 1,
  796.                
  797.                500, "syntax error", 0,
  798.                501, "syntax error", 0,
  799.                502, "CHMOD not implemented", 0,
  800.                530, "not logged in", 0,
  801.                        550, "file unavailable", 0,
  802.  
  803.                421, "service unavailable, closing connection", 0 );
  804.     return $ret;
  805. }
  806.  
  807. # rename a file
  808. sub ftp'rename
  809. {
  810.     local( $old_name, $new_name ) = @_;
  811.     local( $ret );
  812.  
  813.     &ftp'send( "RNFR $old_name" );
  814.  
  815.     # 
  816.     # see what they say
  817.  
  818.     $ret = &ftp'expect( $timeout, 
  819.  
  820.                350, "", 1,
  821.                
  822.                500, "syntax error", 0,
  823.                501, "syntax error", 0,
  824.                502, "RNFR not implemented", 0,
  825.                530, "not logged in", 0,
  826.                        550, "file unavailable", 0,
  827.                        450, "file unavailable", 0,
  828.                
  829.                421, "service unavailable, closing connection", 0);
  830.  
  831.  
  832.     # check if the "rename from" occurred ok
  833.     if( $ret ) {
  834.         &ftp'send( "RNTO $new_name" );
  835.     
  836.         # 
  837.         # see what they say
  838.     
  839.         $ret = &ftp'expect( $timeout, 
  840.     
  841.                        250, "rename $old_name to $new_name", 1, 
  842.  
  843.                    500, "syntax error", 0,
  844.                    501, "syntax error", 0,
  845.                    502, "RNTO not implemented", 0,
  846.                    503, "bad sequence of commands", 0,
  847.                    530, "not logged in", 0,
  848.                            532, "need account for storing files", 0,
  849.                            553, "file name not allowed", 0,
  850.                    
  851.                    421, "service unavailable, closing connection", 0);
  852.     }
  853.  
  854.     return $ret;
  855. }
  856.  
  857. # ------------------------------------------------------------------------------
  858. # These are the lower level support routines
  859.  
  860. sub ftp'expectgot
  861. {
  862.     ($ftp'response, $ftp'fatalerror) = @_;
  863.     if( $ftp_show ){
  864.         print "$ftp'response\n";
  865.     }
  866. }
  867.  
  868. #
  869. #  create the list of parameters for chat'expect
  870. #
  871. #  ftp'expect(time_out, {value, string_to_print, return value});
  872. #     if the string_to_print is "" then nothing is printed
  873. #  the last response is stored in $ftp'response
  874. #
  875. # NOTE: lmjm has changed this code such that the string_to_print is
  876. # ignored and the string sent back from the remote system is printed
  877. # instead.
  878. #
  879. sub ftp'expect {
  880.     local( $ret );
  881.     local( $time_out );
  882.     local( $expect_args );
  883.     
  884.     $ftp'response = '';
  885.     $ftp'fatalerror = 0;
  886.  
  887.     @expect_args = ();
  888.     
  889.     $time_out = shift(@_);
  890.     
  891.     while( @_ ){
  892.         local( $code ) = shift( @_ );
  893.         local( $pre ) = '^';
  894.         if( $code =~ /^\d/ ){
  895.             $pre =~ "[.|\n]*^";
  896.         }
  897.         push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
  898.         shift( @_ );
  899.         push( @expect_args, 
  900.             "&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
  901.     }
  902.     
  903.     # Treat all unrecognised lines as continuations
  904.     push( @expect_args, "^(.*)\\015\\n" );
  905.     push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
  906.     
  907.     # add patterns TIMEOUT and EOF
  908.     
  909.     push( @expect_args, 'TIMEOUT' );
  910.     push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
  911.     
  912.     push( @expect_args, 'EOF' );
  913.     push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
  914.     
  915.     if( $ftp_show > 9 ){
  916.         &printargs( $time_out, @expect_args );
  917.     }
  918.     
  919.     $ret = &chat'expect( $time_out, @expect_args );
  920.     if( $ret == 100 ){
  921.         # we saw a continuation line, wait for the end
  922.         push( @expect_args, "^.*\n" );
  923.         push( @expect_args, "100" );
  924.     
  925.         while( $ret == 100 ){
  926.             $ret = &chat'expect( $time_out, @expect_args );
  927.         }
  928.     }
  929.     
  930.     return $ret;
  931. }
  932.  
  933. #
  934. #  opens NS for io
  935. #
  936. sub ftp'open_data_socket
  937. {
  938.     local( $ret );
  939.     local( $hostname );
  940.     local( $sockaddr, $name, $aliases, $proto, $port );
  941.     local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
  942.     local( $mysockaddr, $family, $hi, $lo );
  943.     
  944.     
  945.     $sockaddr = 'S n a4 x8';
  946.     chop( $hostname = `hostname` );
  947.     
  948.     $port = "ftp";
  949.     
  950.     ($name, $aliases, $proto) = getprotobyname( 'tcp' );
  951.     ($name, $aliases, $port) = getservbyname( $port, 'tcp' );
  952.     
  953. #    ($name, $aliases, $type, $len, $thisaddr) =
  954. #    gethostbyname( $hostname );
  955.     ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
  956.     
  957. #    $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
  958.     $this = $chat'thisproc;
  959.     
  960.     socket(S, &main'PF_INET, &main'SOCK_STREAM, $proto ) || die "socket: $!";
  961.     bind(S, $this) || die "bind: $!";
  962.     
  963.     # get the port number
  964.     $mysockaddr = getsockname(S);
  965.     ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
  966.     
  967.     $hi = ($port >> 8) & 0x00ff;
  968.     $lo = $port & 0x00ff;
  969.     
  970.     #
  971.     # we MUST do a listen before sending the port otherwise
  972.     # the PORT may fail
  973.     #
  974.     listen( S, 5 ) || die "listen";
  975.     
  976.     &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
  977.     
  978.     return &ftp'expect($timeout, 200, "", 1,
  979.     
  980.         500, "syntax error", 0,
  981.         501, "syntax error", 0,
  982.         530, "not logged in", 0,
  983.         421, "service unavailable, closing connection", 0);
  984. }
  985.     
  986. sub ftp'close_data_socket
  987. {
  988.     close(NS);
  989. }
  990.  
  991. sub ftp'send
  992. {
  993.     local($send_cmd) = @_;
  994.     if( $send_cmd =~ /\n/ ){
  995.         print "ERROR, \\n in send string for $send_cmd\n";
  996.     }
  997.     
  998.     if( $ftp_show ){
  999.         local( $sc ) = $send_cmd;
  1000.  
  1001.         if( $send_cmd =~ /^PASS/){
  1002.             $sc = "PASS <somestring>";
  1003.         }
  1004.         print "---> $sc\n";
  1005.     }
  1006.     
  1007.     &chat'print( "$send_cmd\r\n" );
  1008. }
  1009.  
  1010. sub ftp'printargs
  1011. {
  1012.     while( @_ ){
  1013.         print shift( @_ ) . "\n";
  1014.     }
  1015. }
  1016.  
  1017. sub ftp'filesize
  1018. {
  1019.     local( $fname ) = @_;
  1020.  
  1021.     if( ! -f $fname ){
  1022.         return -1;
  1023.     }
  1024.  
  1025.     return (stat( _ ))[ 7 ];
  1026.     
  1027. }
  1028.  
  1029. # make this package return true
  1030. 1;
  1031.